#------------------------------------------------------------------------------

#  读取消费过的会员信息：rawdata
data<-rawdata

# 定义分类变量和数值变量
factor.names<-names(data)[!(sapply(data,class) %in% c('numeric','interger'))]
vector.names<-names(data)[sapply(data,class) %in% c('numeric','interger')]

# 数据初步整理

data$memberid<-data$MemberID<-data$Birthday<-data$email<-NULL

data<-data[outlier.delete(data[,vector.names]),]

# 缺失值处理
data<-lossdelete(data)
lossrate(data)

# add.miss 自定义插补数值型变量
num
data<-add.miss(data,names(data)[lossrate(data)>0],num)

# 分类变量处理
data$cardstatus<-factor(data$cardstatus,levels=c("删除","挂失","注销","停用","过期","初始","休眠","在用"),labels=letters[1:8])
data$sourcechannel<-factor(data$sourcechannel,levels=c("其它","航空公司","银行","总部财务","总部中央","门店","网上售卡","网络会员","市场活动","其它市场活动"),labels=letters[1:10])
data$rnature<-factor(data$rnature,levels=c("免费","折扣","原价"),labels=c('Free','Discount','Full'))
data$levelchangereason<-factor(data$levelchangereason,levels=c("NULL","授权降级","授权升级","活动","积分升级","购买升级"),labels=c('NULL','Down','Up','Act up','Point up','Buy up'))
data$levelchangereason[is.na(data$levelchangereason)]<-"NULL"
data$rmode<-factor(data$rmode,levels=c("PMS","系统后台","门店Pad","iPad","电话","短信","WindowsPhone","Android","iPhone","WAP","WEB注册"),labels=c("WebPMS","CRM","H_Pad","Ipad","CRS","SMS","WindowsPhone","Android","IPhone","WAP","WebSite"))
data$gender<-factor(data$gender,levels=c("男","未知","女"),labels=c('M',"X","F"))

# 指导字段
data$response<-'lapsed'
data$response[is.na(data$liushi)]<-'remain'
data$response<-as.factor(data$response)
data$liushi<-NULL



# 建训练样本
sampleid<-sample(1:nrow(data),round(nrow(data)*0.8,0))
traindata<-data[sampleid,]
testdata<-data[-sampleid,]

# 训练模型
library(C50)
formula<-as.formula("response~.")

model<-train.model(traindata,formula,20,testdata)

n<-which(sapply(model,function(x) x$value)==max(sapply(model,function(x) x$value)))[1]

mem.rules<-model[[n]]$model
mem.rules
summary(mem.rules)
C5imp(mem.rules, metric = "splits")



# 模型评价

model.res<-model.evaluation(data,response,mem.rules)

rm(list=ls()[!(ls() %in% c("mem.rules","rawdata"))])




#==================================================================================
#==================================================================================
#   Appendix (Functions)
#==================================================================================
#==================================================================================

#---查看缺失率,删除缺失率高的字段
lossrate<-function(x){
  a<-apply(is.na(x),2,mean)
  a<-round(a,3)
  return(a)
}

lossdelete<-function(x){
  a<-apply(is.na(x),2,mean)
  a<-round(a,3)
  deletecols<-names(a[a>0.8])
  deleterows<-names(a[a>0&a<0.2])
  for(i in deletecols){
    x[,i]<-NULL
  }
  for(j in deleterows){
    x<-x[!is.na(x[,j]),]  
  }
  return(x)
}

#---分类型变量数据集，相关性分析
cor.factor<-function(data){
  n<-names(data)
  cor<-NULL
  p<-NULL
  for(i in n){
    for(j in n){
      newdata<-na.omit(data[,c(i,j)])
      chisq<-chisq.test(table(newdata[,1],newdata[,2]))
      cor<-c(cor,chisq[[1]])
      p<-c(p,chisq[[3]]>0.05)
    }
  }
  cor[p]<-0
  cor<-matrix(cor,nrow=length(n))
  colnames(cor)<-n
  rownames(cor)<-n
  return(cor)
}


#---删除没有意义的字段
valid.data<-function(data){
  invalid<-na.omit(names(data)[sapply(data,sd,na.rm=T)==0])
  valid<-setdiff(names(data),invalid)
  data<-data[,valid]
  return(data)
}


#---插补缺失值
add.miss<-function(data,col,num){
  if(length(col)==1){
    i=col
    data[is.na(data[,i]),i]<-num
  }
  else{
    for(i in col){
      data[is.na(data[,i]),i]<-num[i]
    }
  }
  return(data)
}

#---oneway 方差分析
fc.test<-function(factor,varible,data){
  fc=NULL
  for(i in factor){
    for(j in varible){
      formula=as.formula(paste(j,"~",i))
      fc=c(fc,oneway.test(formula,data=data,var.equal = TRUE)$p.value<0.05)
    }
  }
  fc=matrix(fc,nrow=length(varible),ncol=length(factor),byrow=F,dimnames=list(varible,factor))
  return(fc)
}

#---创建平衡样本
data.balance<-function(data,v,vlevels,num){
  id=NULL
  for(i in vlevels){
    N<-which(data[,v]==i)
    nsample<-sample(c(1:length(N)),num[i],replace=T)
    id<-c(id,N[nsample])
  }
  newdata<-data[id,]
  return(newdata)
}

#---分类型变量数据集，相关性分析
cor.factor<-function(data){
  n<-names(data)
  cor<-NULL
  p<-NULL
  for(i in n){
    for(j in n){
      newdata<-na.omit(data[,c(i,j)])
      chisq<-chisq.test(table(newdata[,1],newdata[,2]))
      cor<-c(cor,chisq[[1]])
      p<-c(p,chisq[[3]]>0.05)
    }
  }
  cor[p]<-0
  cor<-matrix(cor,nrow=length(n))
  colnames(cor)<-n
  rownames(cor)<-n
  return(cor)
}

#---异常值处理

outlier.delete<-function(data){
  ks<-sapply(data,function(x) ks.test(x+runif(length(x),-0.01,0.01),"pnorm",mean(x),sd(x))$p.value)
  mean<-sapply(data,mean,na.rm=T)
  sd<-sapply(data,sd,na.rm=T)
  Q1<-sapply(data,quantile,0.25,na.rm=T)
  Q3<-sapply(data,quantile,0.75,na.rm=T)
  QR<-Q3-Q1
  
  outlier<-apply(data[,ks<0.05],1,function(x) mean(x>Q1[ks<0.05]-3*QR[ks<0.05] & x<Q3[ks<0.05]+3*QR[ks<0.05],na.rm=T))
  newID<-rownames(data)[outlier>quantile(outlier,0.2)]
  
  if (sum(ks>0.05)>0){
    outlier<-apply(data[,ks>0.05],1,function(x) mean(x>mean[ks>0.05]-3*sd[ks>0.05] & x<mean[ks>0.05]+3*sd[ks>0.05],na.rm=T))  
    newID<-rownames(data)[outlier>quantile(outlier,0.2)]
  }
  return(newID)  
}


#---模型训练

train.model<-function(traindata,formula,times,testdata){
  model<-list()
  for(n in 1:times){
    # 建平衡样本
    num<-round(min(table(traindata$response)$freq),0)
    train<-data.balance(traindata,"response",c('lapsed','remain'),c(1,2)*num)
    
    mem.rules<-C5.0(formula,data=train,rules=T,na.action=na.pass,control = C5.0Control(minCases=100))
    testpre<-predict(mem.rules,testdata,type = "class")
    testpretable<-table(testdata$response,testpre)
    accuracy<-length(which(testdata$response==testpre))/nrow(testdata)
    model[[n]]<-list(value=accuracy,model=mem.rules)  
  }
}


#---模型评价

model.evaluation<-function(data,response,model){
  testpre<-predict(model,data)
  testpretable<-table(data$response,testpre,type = "class")
  accuracy<-length(which(data$response==testpre))/nrow(data)
  target.accuracy<-testpretable['lapsed','lapsed']/sum(testpretable['lapsed',])
  target.recall<-testpretable['lapsed','lapsed']/sum(testpretable[,'lapsed'])
  return(c(accuracy,target.accuracy,target.recall))
}
